(COMMENT GENERALLY USEFUL LISP MACROS)

(DEFPROP DFUNC
	 (LAMBDA (L)
		 (LIST (Q DEFPROP)
		       (CAADR L)
		       (MCONS (Q LAMBDA) (CDADR L) (CDDR L))
		       (Q EXPR)))
	 MACRO)

(DEFPROP MAPDEF
 (LAMBDA (L)
	 (LIST (Q MAPCAR)
	       (SUBST (CADR L)
		      (Q IND)
		      (Q (FUNCTION (LAMBDA (PAIR)
					   (PUTPROP (CAR PAIR)
						    (CADR PAIR)
						    (QUOTE IND))))))
	       (LIST (Q QUOTE) (CDDR L))))
 MACRO)

(DEFPROP MCONS
 (LAMBDA (L)
	 (COND ((NULL (CDDR L)) (CADR L))
	       (T (LIST (Q CONS) (CADR L) (CONS (CAR L) (CDDR L))))))
 MACRO)

(DEFPROP Q (LAMBDA (L) (CONS (QUOTE QUOTE) (CDR L))) MACRO)

(COMMENT END OF GENERAL LISP MACROS)

(COMMENT PROPERTY TABLE PRIMITIVES)

(DEFPROP FIRSTPROP (LAMBDA (L) (CONS (Q CDR) (CDR L))) MACRO)

(DEFPROP LASTPROP (LAMBDA (L) (CONS (Q NULL) (CDR L))) MACRO)

(DEFPROP NEXTPROP (LAMBDA (L) (CONS (Q CDDR) (CDR L))) MACRO)

(DEFPROP PROPFLAG (LAMBDA (L) (CONS (Q CAR) (CDR L))) MACRO)

(DEFPROP PROPTABLE (LAMBDA (L) (CONS (Q CDR) (CDR L))) MACRO)

(DEFPROP PROPVAL (LAMBDA (L) (CONS (Q CADR) (CDR L))) MACRO)

(DFUNC (DELETEPROP IDENT FLAG)
       (PROG (TEM)
	     (SETQ TEM IDENT)
	LOOP (COND ((NULL (CDR TEM)) (RETURN NIL)))
	     (COND ((EQ (CADR TEM) FLAG) (RPLACD TEM (CDDDR TEM))
					 (RETURN T)))
	     (SETQ TEM (CDDR TEM))
	     (GO LOOP)))


(DFUNC (GETGET ATOM PROP)
       (PROG (TEM PTAB)
	     (SETQ PTAB (FIRSTPROP ATOM))
	LOOP (COND ((LASTPROP PTAB) (RETURN NIL)))
	     (COND ((SETQ TEM (SEEKPROP (PROPFLAG PTAB) PROP))
		    (RETURN TEM)))
	     (SETQ PTAB (NEXTPROP PTAB))
	     (GO LOOP)))

(DFUNC (INITPROP IDENT FLAG VAL)
       (RPLACD IDENT (MCONS FLAG VAL (CDR IDENT))))

(DFUNC (SEEKPROP IDENT PROP) (GETL IDENT (LIST PROP)))

(DFUNC (SETPROP IDENT FLAG VAL) (PUTPROP IDENT VAL FLAG))

(COMMENT END OF PROPERTY TABLE PRIMITIVES)

(DECLARE (SPECIAL LINCNT PAGEHEIGHT PAGEWIDTH LAPINDENT OUTEXT)
	 (SPECIAL *SP *TB *CR *LF *VT *FF *CO *PT *LP *RP *SL *AM *RO
		  *AT *LB *RB)
	 (SPECIAL IBASE BASE *NOPOINT)
	 (DEFPROP DATAERR T *FSUBR))

(COMMENT FORMAT PROGRAM MACROS)

(DEFPROP ATLEFT (LAMBDA (L) (LIST (Q EQ) 1 (Q (CURCOL)))) MACRO)

(DEFPROP ATTOP (LAMBDA (L) (LIST (Q EQ) (Q LINCNT) 1)) MACRO)

(DEFPROP CLEANPLATE (LAMBDA (L) (LIST (Q LIST) 0 1 0 NIL)) MACRO)

(DEFPROP COLLOC (LAMBDA (L) (CADR L)) MACRO)

(DEFPROP COLUMN
	 (LAMBDA (L) (LIST (Q GETVAL) (CONS (Q COLLOC) (CDR L))))
	 MACRO)

(DEFPROP GETVAL (LAMBDA (L) (CONS (Q CAR) (CDR L))) MACRO)

(DEFPROP HEIGHT
	 (LAMBDA (L) (LIST (Q GETVAL) (CONS (Q HTLOC) (CDR L))))
	 MACRO)

(DEFPROP HTLOC (LAMBDA (L) (CONS (Q CDR) (CDR L))) MACRO)

(DEFPROP MOLDCHAR
 (LAMBDA (L) (LIST (Q LIST) (LIST (Q LIST) (Q (Q CHAR)) (CADR L))))
 MACRO)

(DEFPROP MOLDEXPR
 (LAMBDA (L) (LIST (Q LIST) (LIST (Q LIST) (Q (Q EXPR)) (CADR L))))
 MACRO)

(DEFPROP MOLDLIST
 (LAMBDA (L)
  (LIST (Q LIST) (LIST (Q MCONS) (Q (Q LIST)) (CADDR L) (CADR L))))
 MACRO)


(DEFPROP MOLDTAB
 (LAMBDA (L) (LIST (Q LIST) (LIST (Q LIST) (Q (Q TAB)) (CADR L))))
 MACRO)

(DEFPROP SETCRLF (LAMBDA (L) (LIST (Q SETTAB) (CADR L) 0)) MACRO)

(DEFPROP SETDOT
	 (LAMBDA (L) (LIST (Q SETCHAR) (CADR L) (Q *PT)))
	 MACRO)

(DEFPROP SETLPR
	 (LAMBDA (L) (LIST (Q SETCHAR) (CADR L) (Q *LP)))
	 MACRO)

(DEFPROP SETRPR
	 (LAMBDA (L) (LIST (Q SETCHAR) (CADR L) (Q *RP)))
	 MACRO)

(DEFPROP SETSPC
	 (LAMBDA (L) (LIST (Q SETCHAR) (CADR L) (Q *SP)))
	 MACRO)

(DEFPROP SETVAL (LAMBDA (L) (CONS (Q RPLACA) (CDR L))) MACRO)

(DEFPROP TEXT
	 (LAMBDA (L) (LIST (Q GETVAL) (CONS (Q TXTLOC) (CDR L))))
	 MACRO)

(DEFPROP TXTLOC (LAMBDA (L) (CONS (Q CDDDR) (CDR L))) MACRO)

(DEFPROP WELDTEXT
	 (LAMBDA (L) (LIST (Q NCONC) (CADR L) (CADDR L)))
	 MACRO)

(DEFPROP WIDTH
	 (LAMBDA (L) (LIST (Q GETVAL) (CONS (Q WDTHLOC) (CDR L))))
	 MACRO)

(DEFPROP WDTHLOC (LAMBDA (L) (CONS (Q CDDR) (CDR L))) MACRO)

(COMMENT END OF FORMAT PROGRAM MACROS)

(DFUNC (ALTERCOL PLATE COL)
       (PROG2 (SETVAL (COLLOC PLATE) COL) PLATE))

(DFUNC (ALTERHT PLATE HT) (PROG2 (SETVAL (HTLOC PLATE) HT) PLATE))

(DFUNC (ALTERTEXT PLATE TXT)
       (PROG2 (SETVAL (TXTLOC PLATE) TXT) PLATE))

(DFUNC (ALTERWDTH PLATE WDTH)
       (PROG2 (SETVAL (WDTHLOC PLATE) WDTH) PLATE))

(DFUNC (CLAP PL ST) (SETCRLF (SETEXPR (SETCRLF PL) ST)))


(DFUNC (COMPOSASSIGN EXPR WIDTH RPARS SLACK)
 (PROG (MARG PLATE REST)
       (SETQ PLATE (CLEANPLATE))
       (SETLPR PLATE)
       (SETEXPR PLATE (CAR EXPR))
       (SETSPC PLATE)
       (SETEXPR PLATE (CADR EXPR))
       (SETQ MARG (ADD1 (COLUMN PLATE)))
       (SETQ REST (COMPOSLIST (CDDR EXPR)
			      (DIFFERENCE WIDTH MARG)
			      (ADD1 RPARS)
			      (PLUS SLACK (SUB1 MARG))))
       (COND ((NOT (GREATERP (FULLWIDTH REST (ADD1 RPARS))
			     (DIFFERENCE WIDTH MARG)))
	      (RETURN (SETRPR (SETLIST PLATE MARG REST)))))
       (SETQ MARG (DIFFERENCE MARG (ADD1 (FLATSIZE (CADR EXPR)))))
       (SETQ REST (COMPOSLIST (CDDR EXPR)
			      (DIFFERENCE WIDTH MARG)
			      (ADD1 RPARS)
			      (PLUS SLACK (SUB1 MARG))))
       (COND ((NOT (GREATERP (FULLWIDTH REST (ADD1 RPARS))
			     (DIFFERENCE WIDTH MARG)))
	      (RETURN (SETRPR (SETLIST PLATE MARG REST)))))
       (RETURN (SETRPR (SETLIST	PLATE
				1
				(COMPOSLIST (CDDR EXPR)
					    (SUB1 WIDTH)
					    (ADD1 RPARS)
					    SLACK))))))

(DE (COMPOSATOMS SHORTS WIDTH RPARS SLACK)
    (PROG (MARG NEXT PLATE)
	  (SETQ PLATE (CLEANPLATE))
	  (COND	((NOT (NULL SHORTS))
		 (SETQ PLATE (COMPOSEXPR (CAR SHORTS)
					 WIDTH
					 RPARS
					 SLACK))
		 (SETQ SHORTS (CDR SHORTS))))
     LOOP (COND ((NULL SHORTS) (RETURN PLATE)))
	  (SETQ NEXT (COMPOSEXPR (CAR SHORTS) WIDTH RPARS SLACK))
	  (SETQ MARG (ADD1 (COLUMN PLATE)))
	  (COND	((GREATERP (FULLWIDTH NEXT
				    (COND ((NULL (CDR SHORTS))
					   (ADD1 RPARS))
					  (T 0)))
			   (DIFFERENCE WIDTH MARG))
		 (SETQ MARG 0)))
	  (SETLIST PLATE MARG NEXT)
	  (SETQ SHORTS (CDR SHORTS))
	  (GO LOOP)))


(DFUNC (COMPOSDEFS EXPR WIDTH RPARS SLACK)
       (PROG (MARG PLATE REST)
	     (SETQ PLATE (CLEANPLATE))
	     (SETLPR PLATE)
	     (SETEXPR PLATE (CAR EXPR))
	     (SETSPC PLATE)
	     (SETEXPR PLATE (CADR EXPR))
	     (SETQ MARG (PLUS (FLATSIZE (CAR EXPR)) 2))
	     (SETQ REST	(COMPOSLIST (CDDR EXPR)
				    (SUB1 WIDTH)
				    (ADD1 RPARS)
				    SLACK))
	     (COND ((GREATERP (FULLWIDTH REST (ADD1 RPARS))
			      (DIFFERENCE WIDTH MARG))
		    (SETQ MARG 1)))
	     (RETURN (SETRPR (SETLIST PLATE MARG REST)))))

(DFUNC (COMPOSDE EXPR WIDTH RPARS SLACK)
       (PROG (MARG MARG1 PLATE REST)
	     (COND ((NOT (ATOM (CADR EXPR)))
		    (RETURN (COMPOSDEFS EXPR WIDTH RPARS SLACK))))
	     (SETQ PLATE (CLEANPLATE))
	     (SETLPR PLATE)
	     (SETEXPR PLATE (CAR EXPR))
	     (SETSPC PLATE)
	     (SETEXPR PLATE (CADR EXPR))
	     (SETSPC PLATE)
	     (SETEXPR PLATE (CADDR EXPR))
	     (SETQ MARG1 (PLUS (FLATSIZE (CAR EXPR)) 2))
	     (SETQ MARG (PLUS MARG1 (FLATSIZE (CADR EXPR)) 1))
	     (SETQ REST	(COMPOSLIST (CDDDR EXPR)
				    (SUB1 WIDTH)
				    (ADD1 RPARS)
				    SLACK))
	     (COND ((GREATERP (FULLWIDTH REST (ADD1 RPARS))
			      (DIFFERENCE WIDTH MARG))
		    (SETQ MARG MARG1)))
	     (COND ((GREATERP (FULLWIDTH REST (ADD1 RPARS))
			      (DIFFERENCE WIDTH MARG))
		    (SETQ MARG 1)))
	     (RETURN (SETRPR (SETLIST PLATE MARG REST)))))


(DFUNC (COMPOSEXPR EXPR WIDTH RPARS SLACK)
 (PROG (FIRST MARG PLATE REST TEM)
       (SETQ COMPOSEXPRCOUNT (ADD1 COMPOSEXPRCOUNT))
       (SETQ PLATE (SETEXPR (CLEANPLATE) EXPR))
       (COND ((OR (ATOM EXPR)
		  (NOT (GREATERP (PLUS (COLUMN PLATE) RPARS) WIDTH)))
	      (RETURN PLATE)))
       (COND ((AND (ATOM (CAR EXPR))
		   (NOT (NUMBERP (CAR EXPR)))
		   (SETQ TEM (GETGET (CAR EXPR) (Q EXPRFORM))))
	      (RETURN ((PROPVAL TEM) EXPR WIDTH RPARS SLACK))))
       (SETQ PLATE (SETLPR (CLEANPLATE)))
       (COND ((ATOM (CDR EXPR))
	      (RETURN (SETRPR (SETLIST PLATE
				       1
				       (COMPOSLIST EXPR
						   (SUB1 WIDTH)
						   (ADD1 RPARS)
						   SLACK))))))
       (SETQ FIRST (COMPOSEXPR (CAR EXPR) (SUB1 WIDTH) 0 SLACK))
       (SETQ MARG (PLUS (COLUMN FIRST) 2))
       (COND ((ATOM (CAR EXPR))
	      (SETQ REST (COMPOSLIST (CDR EXPR)
				     (DIFFERENCE WIDTH MARG)
				     (ADD1 RPARS)
				     (PLUS SLACK (SUB1 MARG))))
	      (COND ((LESSP (PLUS SLACK (DIFFERENCE WIDTH MARG))
			    (FULLWIDTH REST (ADD1 RPARS)))
		     (SETQ SLACKCOUNT (ADD1 SLACKCOUNT))
		     (SETQ PLATE
			   (SETLIST (SETEXPR PLATE
						     (CAR EXPR))
					    1
					    (COMPOSLIST	(CDR EXPR)
							(SUB1 WIDTH)
							(ADD1 RPARS)
							SLACK))))
		    (T (SETQ PLATE
			     (SETLIST (SETEXPR PLATE
						       (CAR EXPR))
					      MARG
					      REST)))))
	     (T	(SETQ REST (COMPOSLIST (CDR EXPR)
				       (SUB1 WIDTH)
				       (ADD1 RPARS)
				       SLACK))
		(COND ((OR (GREATERP (HEIGHT FIRST) 1)
			   (LESSP (DIFFERENCE WIDTH MARG)
				  (FULLWIDTH REST (ADD1 RPARS))))
		       (SETQ PLATE
			     (SETLIST PLATE
					      1
					      (SETPLATE	FIRST
							REST))))
		      (T (SETQ PLATE
			       (SETLIST	(SETEXPR PLATE
							 (CAR EXPR))
						MARG
						REST))))))
       (COND
	((GREATERP (SETQ ELONG (QUOTIENT (PLUS (HEIGHT PLATE) 0.0)
					 (PLUS (WIDTH PLATE) 0.0)))
		   MAXELONG)
	 (SETQ ATOMCOUNT (ADD1 ATOMCOUNT))
	 (COND (NEWFEAT	(SETQ PLATE
			 (SETLIST (SETLPR (CLEANPLATE))
					  1
					  (COMPOSATOMS EXPR
						       (SUB1 WIDTH)
						       (ADD1 RPARS)
						       SLACK)))))))
       (RETURN (SETRPR PLATE))))
)))))


(DFUNC (COMPOSLAP STATS WIDTH RPARS SLACK)
 (PROG (PLATE TEM)
       (SETQ PLATE (CLEANPLATE))
  LOOP (COND ((NULL STATS) (RETURN PLATE)))
       (COND ((NULL (CAR STATS))
	      (SETEXPR (SETTAB (SETCRLF PLATE) LAPINDENT) NIL))
	     ((ATOM (CAR STATS))
	      (SETEXPR (SETTAB PLATE 1) (CAR STATS)))
	     ((AND (ATOM (CAAR STATS))
		   (NOT (NUMBERP (CAAR STATS)))
		   (SETQ TEM (SEEKPROP (CAAR STATS) (Q LAPFORM))))
	      ((PROPVAL TEM) PLATE (CAR STATS)))
	     (T	(SETLIST PLATE
			 LAPINDENT
			 (COMPOSEXPR (CAR STATS)
				     (*DIF WIDTH LAPINDENT)
				     RPARS
				     SLACK))))
       (SETQ STATS (CDR STATS))
       (GO LOOP)))

(DFUNC (COMPOSLIST LIST WIDTH RPARS SLACK)
       (PROG (PLATE)
	     (SETQ PLATE (CLEANPLATE))
	LOOP (SETPLATE PLATE
		       (COMPOSEXPR (CAR LIST)
				   WIDTH
				   (COND ((NULL (CDR LIST)) RPARS)
					 ((ATOM (CDR LIST))
					  (PLUS	RPARS
						(FLATSIZE (CDR LIST))
						3))
					 (T 0))
				   SLACK))
	     (SETQ LIST (CDR LIST))
	     (COND ((NULL LIST) (RETURN PLATE)))
	     (COND ((ATOM LIST) (RETURN (SETATOM PLATE LIST))))
	     (GO LOOP)))

(DFUNC (COMPOSMAPDEF EXPR WIDTH RPARS SLACK)
       (PROG (ATOMS MARG PLATE)
	     (SETQ PLATE (CLEANPLATE))
	     (SETLPR PLATE)
	     (SETEXPR PLATE (CAR EXPR))
	     (SETSPC PLATE)
	     (SETEXPR PLATE (CADR EXPR))
	     (SETSPC PLATE)
	     (SETQ MARG (COLUMN PLATE))
	     (SETQ ATOMS (COMPOSATOMS (CDDR EXPR)
				      (DIFFERENCE WIDTH MARG)
				      (ADD1 RPARS)
				      SLACK))
	     (RETURN (SETRPR (SETLIST PLATE MARG ATOMS)))))


(DFUNC (COMPOSPROG EXPR WIDTH RPARS SLACK)
       (PROG (INDENT PLATE PVARS STATS)
	     (SETQ PLATE (CLEANPLATE))
	     (SETLPR PLATE)
	     (SETEXPR PLATE (CAR EXPR))
	     (SETSPC PLATE)
	     (SETQ INDENT (PLUS (FLATSIZE (CAR EXPR)) 2))
	     (SETQ PVARS (COMPOSPVARS (CADR EXPR)
				      (DIFFERENCE WIDTH INDENT)
				      (COND ((NULL (CDDR EXPR))
					     (ADD1 RPARS))
					    (T 0))
				      SLACK))
	     (SETLIST PLATE INDENT PVARS)
	     (SETQ STATS (CDDR EXPR))
	LOOP (COND ((NULL STATS) (RETURN (SETRPR PLATE))))
	     (COND ((ATOM (CAR STATS))
		    (SETEXPR (SETTAB PLATE 1) (CAR STATS)))
		   (T (SETLIST PLATE
			       INDENT
			       (COMPOSEXPR (CAR STATS)
					   (DIFFERENCE WIDTH INDENT)
					   (COND ((NULL (CDR STATS))
						  (ADD1 RPARS))
						 (T 0))
					   SLACK))))
	     (SETQ STATS (CDR STATS))
	     (GO LOOP)))

(DFUNC (COMPOSPVARS VARS WIDTH RPARS SLACK)
 (PROG (ATOMS PLATE)
       (SETQ PLATE (SETEXPR (CLEANPLATE) VARS))
       (COND ((OR (ATOM VARS)
		  (NOT (GREATERP (COLUMN PLATE)
				 (DIFFERENCE WIDTH RPARS))))
	      (RETURN PLATE)))
       (SETQ ATOMS (COMPOSATOMS	VARS
				(SUB1 WIDTH)
				(ADD1 RPARS)
				SLACK))
       (RETURN (SETRPR (SETLIST (SETLPR (CLEANPLATE)) 1 ATOMS)))))

(DFUNC (COMPOSSPECIAL EXPR WIDTH RPARS SLACK)
       (PROG (ATOMS INDENT PLATE)
	     (SETQ PLATE (CLEANPLATE))
	     (SETQ INDENT (PLUS (FLATSIZE (CAR EXPR)) 2))
	     (SETLPR PLATE)
	     (SETEXPR PLATE (CAR EXPR))
	     (SETSPC PLATE)
	     (SETQ ATOMS (COMPOSATOMS (CDR EXPR)
				      (DIFFERENCE WIDTH INDENT)
				      (ADD1 RPARS)
				      SLACK))
	     (RETURN (SETRPR (SETLIST PLATE INDENT ATOMS)))))

(DFUNC (CURCOL) (DIFFERENCE (ADD1 (LINELENGTH NIL)) (CHRCT)))

(DEFPROP DATAERR
	 (LAMBDA (L) (PROG NIL (INC NIL T) (OUTC NIL T) (PRINT L)))
	 FEXPR)


(DFUNC (DOSPEC EXPR WIDTH RPARS SLACK)
       ((GET (CAR EXPR) (Q SPECCOMPOS)) EXPR WIDTH RPARS SLACK))

(DFUNC (DOTOPFORM1 EXPR) ((GET (CAR EXPR) (Q TOPFORM1)) EXPR))

(DFUNC (DOFILE DOREADS INFILE OUTFILE)
       (PROG (LINCNT)
	     (SETQ LINCNT 0)
	     (EVAL (MCONS (Q INPUT) (Q INCHAN) INFILE))
	     (EVAL (MCONS (Q OUTPUT) (Q OUTCHAN) OUTFILE))
	     (INC (Q INCHAN) NIL)
	     (OUTC (Q OUTCHAN) NIL)
	     (DOREADS)
	     (OUTC NIL T)
	     (INC NIL T)))

(DE (FE XPR)
    (PROG (LINCNT) (SETQ LINCNT 1) (RETURN (FORMANEXPR XPR))))

(SETQ MAXELONG 2)

(DFUNC (FINIT) (PROG2 (EXCISE) (INITFN (Q FSTART))))

(DFUNC (FORMANEXPR ANEXPR)
       (PLACEONPAGE (COMPOSEXPR ANEXPR (LINELENGTH NIL) 0 0)))

(DEFPROP FORMAT
 (LAMBDA (L)
  (PROG (DEV)
	(SETQ DEV (Q DSK:))
   LOOP	(COND ((NULL L) (RETURN NIL)))
	(COND ((%DEVP (CAR L)) (SETQ DEV (CAR L)) (SETQ L (CDR L))))
	(FORMFILE (LIST DEV (CAR L))
		  (LIST	(Q DSK:)
			(CONS (COND ((ATOM (CAR L)) (CAR L))
				    (T (CAAR L)))
			      OUTEXT)))
	(SETQ L (CDR L))
	(GO LOOP)))
 FEXPR)

(DFUNC (FORMATEXPR NAME PROP FLAG)
       (FORMANEXPR (LIST (Q DEFPROP) NAME PROP FLAG)))

(DFUNC (FORMATFUN NAME)
       (PROG (DONE PLIST PROP)
	     (SETQ PLIST (FIRSTPROP NAME))
	LOOP (COND ((LASTPROP PLIST) (RETURN (REVERSE DONE))))
	     (SETQ PROP (SEEKPROP (PROPFLAG PLIST) (Q PROPFORM)))
	     (COND ((NULL PROP) (GO ELOOP)))
	     (SETQ DONE (CONS (CONS NAME (PROPFLAG PLIST)) DONE))
	     ((PROPVAL PROP) NAME (PROPVAL PLIST) (PROPFLAG PLIST))
	ELOOP(SETQ PLIST (NEXTPROP PLIST))
	     (GO LOOP)))

(DFUNC (FORMATVALUE NAME PROP FLAG)
       (FORMANEXPR (LIST (Q SETQ) NAME (CDR PROP))))

(DFUNC (FORMF) (PROG NIL (PRINC *FF) (SETQ LINCNT 1)))


(DFUNC (FORMATOM EXPR) (FORMANEXPR EXPR))

(DFUNC (FORMLAP CALL)
       (PLACEONPAGE (COMPOSLAP (READLAP CALL) (LINELENGTH NIL) 0 0)))

(DFUNC (FORMFILE INFILE OUTFILE)
       (PROG (LINCNT STARTTIME)
	     (SETQ STARTTIME (TIME))
	     (INC (EVAL (MCONS (Q INPUT) (GENSYM) INFILE)))
	     (OUTC (EVAL (MCONS (Q OUTPUT) (GENSYM) OUTFILE)))
	     (LINELENGTH PAGEWIDTH)
	     (SETQ LINCNT 1)
	     (FORMREADS)
	     (INC NIL T)
	     (OUTC NIL T)
	     (PRINTRESULTS (CADR INFILE) STARTTIME (TIME))
	     (RETURN NIL)))

(DFUNC (FORMREAD EXPR)
       (PROG (FORM)
	     (COND ((ATOM EXPR) (RETURN (FORMATOM EXPR))))
	     (COND ((AND (ATOM (CAR EXPR))
			 (NOT (NUMBERP (CAR EXPR)))
			 (SETQ FORM (GETGET (CAR EXPR) (Q TOPFORM))))
		    (RETURN ((PROPVAL FORM) EXPR))))
	     (RETURN (FORMANEXPR EXPR))))

(DEFPROP FORMFUNS
 (LAMBDA (NAMES)
  (PROG (DONE LINCNT)
	(SETQ LINCNT 1)
	(LINEF 1)
   LOOP	(COND ((NULL NAMES) (OUTC NIL T) (RETURN DONE)))
	(COND ((NOT (ATOM (CAR NAMES)))
	       (OUTC (EVAL (CONS (Q OUTPUT) (CAR NAMES))) NIL))
	      (T (SETQ DONE (APPEND DONE (FORMATFUN (CAR NAMES))))))
	(SETQ NAMES (CDR NAMES))
	(GO LOOP)))
 FEXPR)

(DFUNC (FORMREADS) (READLOOP (FUNCTION FORMREAD)))

(DFUNC (FSTART)
 (PROG (LINCNT)
       (SETQ LINCNT 0)
       (INITFN NIL)
       (COND ((NOT (NULL (ERRSET (INPUT SYS: (FORMAT . INI)) NIL)))
	      (SYSIN (FORMAT . INI))))
       (COND ((NOT (NULL (ERRSET (INPUT DSK: (FORMAT . INI)) NIL)))
	      (SYSIN DSK: (FORMAT . INI))))
       (LINEF 1)
       (PRINL (Q (LISP FORMAT PROGRAM)))))

(DFUNC (FULLWIDTH PLATE RPARS)
       (MAX (WIDTH PLATE) (PLUS (COLUMN PLATE) RPARS)))


(DFUNC (LINEF NUM)
       (PROG NIL
	     (COND ((LESSP NUM 0) (RETURN NIL)))
	     (SETQ LINCNT (PLUS LINCNT NUM))
	LOOP (COND ((ZEROP NUM) (RETURN NIL)))
	     (TERPRI)
	     (SETQ NUM (SUB1 NUM))
	     (GO LOOP)))

(DFUNC (MAX N M) (COND ((GREATERP N M) N) (T M)))

(DFUNC (PLACEONPAGE PLATE)
       (PROG NIL
	     (COND ((GREATERP (ADD1 (HEIGHT PLATE))
			      (DIFFERENCE PAGEHEIGHT (SUB1 LINCNT)))
		    (COND ((NOT (ATTOP)) (FORMF)))))
	     (PRINTPLATE (TEXT PLATE) 0)
	     (COND ((NOT (ATLEFT)) (LINEF 2)))
	     (RETURN NIL)))

(DFUNC (PRINL L) (MAPC (FUNCTION PRINS) L))

(DFUNC (PRINS FN)
 (PROG2	(COND ((GREATERP (ADD1 (FLATSIZE FN)) (CHRCT)) (LINEF 1)))
	(PRINTEXPR FN)))

(DFUNC (PRINTEXPR XPR) (PROG2 (PRIN1 XPR) (PRINC *SP)))

(DFUNC (PRINTN CHAR NUM)
       (PROG (NO)
	     (SETQ NO 1)
	LOOP (COND ((LESSP NUM NO) (RETURN NUM)))
	     (PRINC CHAR)
	     (SETQ NO (ADD1 NO))
	     (GO LOOP)))

(DFUNC (PRINTPLATE LIST TAB)
       (PROG (COM)
	LOOP (COND ((NULL LIST) (RETURN NIL)))
	     (SETQ COM (CAR LIST))
	     (COND ((EQ (CAR COM) (Q EXPR)) (PRIN1 (CADR COM)))
		   ((EQ (CAR COM) (Q CHAR)) (PRINC (CADR COM)))
		   ((EQ (CAR COM) (Q TAB))
		    (TABTO (ADD1 (PLUS TAB (CADR COM)))))
		   ((EQ (CAR COM) (Q LIST))
		    (PRINTPLATE (CDDR COM) (PLUS TAB (CADR COM))))
		   (T (DATAERR BADCOPY-PRINTPLATE)))
	     (SETQ LIST (CDR LIST))
	     (GO LOOP)))


(DFUNC (PRINTRESULTS FILENAME STARTTIME FINISHTIME)
 (PROG (BASE *NOPOINT TENTHS)
       (SETQ BASE 12)
       (SETQ *NOPOINT T)
       (PRINT FILENAME)
       (PRINL (Q (FORMATTED IN)))
       (SETQ TENTHS (QUOTIENT (DIFFERENCE FINISHTIME STARTTIME) 144))
       (PRINC (QUOTIENT TENTHS 12))
       (PRINC *PT)
       (PRINL (LIST (REMAINDER TENTHS 12) (Q SECONDS)))
       (RETURN NIL)))

(DFUNC (READLAP CALL)
       (PROG (CODE STAT)
	     (SETQ CODE (LIST CALL))
	READ (SETQ STAT (ERRSET (READ)))
	     (COND ((NULL STAT) (DATAERR READERR-READLAP)))
	     (COND ((EQ STAT (Q $EOF$)) (DATAERR EOF-READLAP)))
	     (SETQ STAT (CAR STAT))
	     (SETQ CODE (CONS STAT CODE))
	     (COND ((NULL STAT) (RETURN (REVERSE CODE))))
	     (GO READ)))

(DFUNC (READLOOP ACTFUNC)
       (PROG (EXPR)
	LOOP (SETQ EXPR (ERRSET (READ)))
	     (COND ((NULL EXPR) (DATAERR READERR)))
	     (COND ((EQ EXPR (Q $EOF$)) (RETURN NIL)))
	     (ACTFUNC (CAR EXPR))
	     (GO LOOP)))

(DFUNC (SETATOM PLATE ATOM)
       (SETEXPR (SETSPC (SETDOT (SETSPC PLATE))) ATOM))

(DFUNC (SETCHAR PLATE CHAR)
       (ALTERWDTH (ALTERCOL (ALTERTEXT PLATE
				       (WELDTEXT (TEXT PLATE)
						 (MOLDCHAR CHAR)))
			    (ADD1 (COLUMN PLATE)))
		  (MAX (COLUMN PLATE) (WIDTH PLATE))))

(DFUNC (SETEXPR PLATE EXPR)
       (ALTERWDTH (ALTERCOL (ALTERTEXT PLATE
				       (WELDTEXT (TEXT PLATE)
						 (MOLDEXPR EXPR)))
			    (PLUS (COLUMN PLATE) (FLATSIZE EXPR)))
		  (MAX (COLUMN PLATE) (WIDTH PLATE))))

(DFUNC (SETLIST PLATE NUM LIST)
 (ALTERCOL
  (ALTERWDTH (ALTERHT (ALTERTEXT (SETTAB PLATE NUM)
				 (WELDTEXT (TEXT PLATE)
					   (MOLDLIST (TEXT LIST)
						     NUM)))
		      (COND ((LESSP NUM (COLUMN PLATE))
			     (PLUS (HEIGHT PLATE) (HEIGHT LIST)))
			    (T (SUB1 (PLUS (HEIGHT PLATE)
					   (HEIGHT LIST))))))
	     (MAX (WIDTH PLATE) (PLUS NUM (WIDTH LIST))))
  (PLUS NUM (COLUMN LIST))))


(DFUNC (SETPLATE PLATE1 PLATE2)
 (ALTERCOL (ALTERHT (ALTERWDTH (ALTERTEXT (SETCRLF PLATE1)
					  (WELDTEXT (TEXT PLATE1)
						    (TEXT PLATE2)))
			       (MAX (WIDTH PLATE1) (WIDTH PLATE2)))
		    (SUB1 (PLUS (HEIGHT PLATE1) (HEIGHT PLATE2))))
	   (COLUMN PLATE2)))

(DFUNC (SETTAB PLATE COL)
 (ALTERCOL
  (ALTERWDTH (ALTERHT (ALTERTEXT PLATE
				 (COND ((EQ (COLUMN PLATE) COL)
					(TEXT PLATE))
				       (T (WELDTEXT (TEXT PLATE)
						    (MOLDTAB COL)))))
		      (COND ((LESSP COL (COLUMN PLATE))
			     (ADD1 (HEIGHT PLATE)))
			    (T (HEIGHT PLATE))))
	     (MAX (WIDTH PLATE) COL))
  COL))

(DFUNC (TABTO COL)
 (PROG NIL
       (COND ((GREATERP (CURCOL) COL) (LINEF 1)))
       (COND ((EQUAL (DIFFERENCE COL (CURCOL)) 1) (PRINC *SP)
						  (RETURN NIL)))
       (PRINTN *TB
	       (DIFFERENCE (LSH (SUB1 COL) -3)
			   (LSH (SUB1 (CURCOL)) -3)))
       (PRINTN *SP (DIFFERENCE COL (CURCOL)))))

(SETQ OUTEXT (QUOTE FMT))

(SETQ PAGEHEIGHT 75)

(SETQ PAGEWIDTH 120)

(SETQ LAPINDENT 10)

(MAPCAR	(FUNCTION (LAMBDA (PAIR)
			  (PROG2 (SET (CAR PAIR)
				      (INTERN (ASCII (CADR PAIR))))
				 (CAR PAIR))))
	(QUOTE ((*SP 40) (*TB 11)
			 (*CR 15)
			 (*LF 12)
			 (*VT 13)
			 (*FF 14)
			 (*CO 54)
			 (*PT 56)
			 (*LP 50)
			 (*RP 51)
			 (*SL 57)
			 (*AM 33)
			 (*AT 100)
			 (*RO 177)
			 (*COLON 72)
			 (*LB 133)
			 (*RB 135))))


(MAPDEF LAPFORM (LAP CLAP))

(MAPDEF EXPRFORM (SPECCOMPOS DOSPEC))

(MAPDEF PROPFORM (EXPR FORMATEXPR) (FEXPR FORMATEXPR)
		 (MACRO FORMATEXPR) (VALUE FORMATVALUE))

(MAPDEF SPECCOMPOS (COMMENT COMPOSSPECIAL) (DE COMPOSDE)
		   (DEFPROP COMPOSDEFS) (DF COMPOSDE)
		   (DFUNC COMPOSDEFS) (DM COMPOSDE)
		   (GETSYM COMPOSMAPDEF) (LABEL COMPOSASSIGN)
		   (LAMBDA COMPOSDEFS) (MAPDEF COMPOSMAPDEF)
		   (PROG COMPOSPROG) (SETQ COMPOSASSIGN)
		   (SPECIAL COMPOSSPECIAL))

(MAPDEF TOPFORM (TOPFORM1 DOTOPFORM1))

(MAPDEF TOPFORM1 (LAP FORMLAP))

(SETQ MAXELONG 1)

(SETQ NEWFEAT NIL)

(SETQ ATOMCOUNT 0)

(SETQ SLACKCOUNT 0)

(SETQ COMPOSEXPRCOUNT 0)